Project report

majors-list description

recent-grads description

science-and-engineering-2010-2019 description

Load Packages:

library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──

## ✓ ggplot2 3.3.5     ✓ purrr   0.3.4
## ✓ tibble  3.1.3     ✓ dplyr   1.0.7
## ✓ tidyr   1.1.3     ✓ stringr 1.4.0
## ✓ readr   2.0.1     ✓ forcats 0.5.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(scales)

## 
## Attaching package: 'scales'

## The following object is masked from 'package:purrr':
## 
##     discard

## The following object is masked from 'package:readr':
## 
##     col_factor

library(naniar)

Load data

majors_list <- read.csv("./majors-list.csv")
recent_grads <- read.csv("./recent-grads.csv")
se_data <- read.csv("./se_2010_2019.csv")

majors_list <- as_tibble(majors_list)
recent_grads <- as_tibble(recent_grads)
se_data <- as_tibble(se_data)
se_data <- se_data %>% 
  rename(
    Science_Engineering_Total = Science_Engineering
    )

Check for missing values

Lets check for any missing values and decide on how to handle them across data

vis_miss(majors_list)

The NA in majors list data represents education level below bachelors degree

vis_miss(recent_grads)

The only major category with partial missing data is FOOD SCIENCE of Agriculture & Natural Resources. It does not contain data about the total number of men, women and share of women.

vis_miss(se_data)

There is no missing data for both year and Science_Engineering_Total

1. What are the most popular 15 majors?

majors_sorted <- recent_grads %>%
  arrange(desc(Median)) %>%
  mutate(Major = str_to_title(Major),
         Major = fct_reorder(Major, Median))

majors_sorted %>%
  mutate(Major = fct_reorder(Major, Total)) %>%
  arrange(desc(Total)) %>%
  head(15) %>%
  ggplot(aes(Major, Total, fill = Major_category)) +
  geom_col() +
  coord_flip() +
  scale_y_continuous() +
  labs(x = "",
       y = "Total # of graduates")

Psychology seems to be the most popular Major among recent grads, followed by Business Management and Administration. Although category Psychology tops the list, 1/4 of the majors are from Business category.

2. What are the least popular 15 majors?

majors_sorted %>%
  mutate(Major = fct_reorder(Major, Total)) %>%
  arrange(desc(Total)) %>%
  tail(15) %>%
  ggplot(aes(Major, Total, fill = Major_category)) +
  geom_col() +
  coord_flip() +
  scale_y_continuous() +
  labs(x = "",
       y = "Total # of graduates")

## Warning: Removed 1 rows containing missing values (position_stack).

Military Technologies is to be the least popular in Majors with less than 500 people taking it. Categories Engineering and Education together dominate the least popular majors.

Which major categories earn the most?

majors_sorted %>%
  group_by(Major_category) %>%
  summarize(Total = median(Total))%>%
  mutate(Major_category = fct_reorder(Major_category, Total)) %>%
  ggplot(aes(Major_category, Total)) +
  geom_col() +
  scale_y_continuous() +
  coord_flip()

## Warning: Removed 1 rows containing missing values (position_stack).

majors_sorted %>%
  mutate(Major_category = fct_reorder(Major_category, Median)) %>%
  ggplot(aes(Major_category, Median, fill = Major_category)) +
  geom_boxplot() +
  scale_y_continuous(labels = dollar_format()) +
  expand_limits(y = 0) +
  coord_flip() +
  theme(legend.position = "none")

Its interesting that the least popular majors earn the most while the most popular majors are down the scale. Business and Social Science are the only majors in the popular 5 and has highest median pay.

Applicability of the approach:

The data only contains the total of different categories and median salary from samples. As we do not have information on mean, we use the two proportion z-test.

Formulation:

Two sample Z-test (Upper tailed): Hypothesis: The employment rate of people who took TEM(Technology, Engineering and Mathematics) is less than or equal to those who took business. - H₀ : p_e \(\le\) p_b - H_A : p_e > p_b - let significance level \(\alpha\) = 0.05

Decision rule: Since \(\alpha\) = 0.05, and we are using z-test, the decision rule is to “Reject H₀ if Z \(\ge\) 1.645

Checks of Assumption:

here, Let e denote: Engineering, Computer and Mathematics Major and, b denotes: Business

Since the value of z is given by \[z = \frac { p_e - p_b}{\sqrt{ p * (1- p) *(1/n_e + 1/n_b)}}\]

\[ p_e = \frac{Employed_e}{Employed_e + Unemployed_e} \implies p_e = 0.9317863\] \[ p_b = \frac{Employed_b}{Employed_b+ Unemployed_b} \implies p_b = 0.9316484\] \[ p = \frac{ Employed_e + Employed_b}{(Employed_e + Unemployed_e) +(Employed_b+ Unemployed_b)} \implies p = 0.9317003 \]

\[n_e = 706456, n_b = 1168619\]

Since, to perform a two proportions z test is valid only when sample size (n) is large enough. \(n_ep\), \(n_e(1-p)\), \(n_bp\), \(n_b(1-p)\) should be \(\ge\) 5. Here, as \(n_ep= 658205.3\) , \(n_e(1-p) = 48250.71\), \(n_bp = 1088803\) and \(n_b(1-p) = 79816.29\), we can proceed to perform z test on the data.

The employment rate of people who took TEM(Technology, Engineering and Mathematics) is less than or equal to those who took business.

Lets gather the required data into a tibble for ease of reference.

temp_vs_b  <- eng_tech %>%
  summarize(Men = sum(Men),
            Women = sum(Women),
            Major_category = "Engineering, Computers & Mathematics",
            Total = sum(Total),
            Employed = sum(Employed),
            Full_time = sum(Full_time),
            Part_time = sum(Part_time),
            Full_time_year_round = sum(Full_time_year_round),
            Unemployed = sum(Unemployed),
            Unemployed_rate =   sum(Unemployed)/sum(Unemployed) + sum(Employed),
            College_jobs = sum(College_jobs),
            Non_college_jobs = sum(Non_college_jobs),
            Low_wage_jobs = sum(Low_wage_jobs),
            MedianSalary = median(MedianSalary),
            Emp_total = sum(Employed)+ sum(Unemployed)) %>%
  mutate(ShareWomen = Women / Total) %>%
  arrange(desc(Employed))

temp_vs_b <- temp_vs_b %>% add_row(business)
temp_vs_a <- temp_vs_b %>% add_row(arts)

Test for hypothesis, H₀ : p_e \(\le\) p_b

res_temp_vs_b <- prop.test(x=c(temp_vs_b$Employed[1],temp_vs_b$Employed[2]), n=c(temp_vs_b$Emp_total[1],temp_vs_b$Emp_total[2]),alternative = "greater") 

res_temp_vs_b

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  c(temp_vs_b$Employed[1], temp_vs_b$Employed[2]) out of c(temp_vs_b$Emp_total[1], temp_vs_b$Emp_total[2])
## X-squared = 0.12939, df = 1, p-value = 0.3595
## alternative hypothesis: greater
## 95 percent confidence interval:
##  -0.0004884284  1.0000000000
## sample estimates:
##    prop 1    prop 2 
## 0.9317863 0.9316484

Interpretation of Result:

From the results of z test, we can see that the p-value of the hypothesis is equal to 0.35, the result is not significant. Thus we fail to reject the hypothesis that the employment rate of people who took TEM(Technology, Engineering and Mathematics) is less than or equal to those who took business.

Application of Approach:

Fit an linear regression model over the time series se_data to predict the number of students taking Science and Engineering majors given the year #### Formulation Predict number of students taking Science and Engineering major given the year. #### Check for assumptions

plot(se_data$Year, se_data$Science_Engineering_Total , main="Science and Engineering Major Estimated Total over years 2010-2019",
   xlab="year", ylab="Science and Engineering Major Estimated Total", pch=19)

par(mfrow=c(1, 2))  # divide graph area in 2 columns
boxplot(se_data$Year, main="year", sub=paste("Outlier rows: ", boxplot.stats(se_data$Year)$out))  # box plot for 'Year'
boxplot(se_data$Science_Engineering_Total, main="Science_Engineering_Total", sub=paste("Outlier rows: ", boxplot.stats(se_data$Science_Engineering_Total)$out))  # box plot for 'Science_Engineering_Total'

cor(se_data$Year, se_data$Science_Engineering_Total) 

## [1] 0.995729

As the value is close to 1 there is a strong relationship between the variables

se_lr <- lm( Science_Engineering_Total ~ Year,data = se_data)
summary(se_lr)

## 
## Call:
## lm(formula = Science_Engineering_Total ~ Year, data = se_data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -230108 -189820    3226  151470  358029 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.460e+09  4.861e+07  -30.03 1.64e-09 ***
## Year         7.360e+05  2.413e+04   30.50 1.45e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 219200 on 8 degrees of freedom
## Multiple R-squared:  0.9915, Adjusted R-squared:  0.9904 
## F-statistic: 930.5 on 1 and 8 DF,  p-value: 1.448e-09

The residuals look close to symmetrical. The least square estimates of the fitted line has the intercept -1.460e+09 and a slope 7.360e+05 and the p-value of Year is statistically significant as 1.45e-09 is less than 0.05. A significant p-value for the year means that it will give us a reliable guess of the number of people taking Science Engineering Major.

As the R-squared is 0.9915, it means that year can explain 99% of variation in Science_Engineering_total. The Adjusted R-squared is the R-squared scaled by the number of parameters in the model.The Degrees of freedom of the model is 8.

plot(Science_Engineering_Total ~ Year,data=se_data)
abline(se_lr, col="blue")

plot(se_lr)

testdata<- data.frame(Year=2020)
predict(se_lr,testdata)

##        1 
## 26923972

AIC(se_lr)

## [1] 278.0983

BIC(se_lr)

## [1] 279.006

Validation of approach

Interpretation of the result

The model is captures the relationship among the variables well.